home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / COM.PAS < prev    next >
Pascal/Delphi Source File  |  1997-03-02  |  22KB  |  897 lines
  1. UNIT Com;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ Communication routines                        Last changed: 02.03.97 SA  ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-97 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. {$IFDEF PMode}
  14.   {$C FIXED PRELOAD PERMANENT}
  15. {$ENDIF}
  16.  
  17. INTERFACE
  18.  
  19. USES Use32, {$IFDEF OS2}OS2Def, {$IFDEF MaxComm}MaxComm, {$ENDIF}{$ENDIF}
  20.      Dos, OpRoot, PoPTypes;
  21.  
  22. CONST
  23.   TxBufSize      = 4096;
  24.   RxBufSize      = 2048;
  25.  
  26. TYPE
  27.   AStatus = Word;
  28.  
  29.   PRealModeRegs = ^TRealModeRegs;
  30.   TRealModeRegs = record
  31.     case Integer of
  32.       0: (
  33.         EDI, ESI, EBP, EXX, EBX, EDX, ECX, EAX: Longint;
  34.         Flags, ES, DS, FS, GS, IP, CS, SP, SS: Word);
  35.       1: (
  36.         DI, DIH, SI, SIH, BP, BPH, XX, XXH: Word;
  37.         case Integer of
  38.           0: (
  39.             BX, BXH, DX, DXH, CX, CXH, AX, AXH: Word);
  40.           1: (
  41.             BL, BH, BLH, BHH, DL, DH, DLH, DHH,
  42.             CL, CH, CLH, CHH, AL, AH, ALH, AHH: Byte));
  43.   END;
  44.  
  45.   PAbsCom = ^TAbsCom;
  46.   TAbsCom = OBJECT(Root)
  47.     LastStatus  : AStatus;
  48.     TxBuf       : Pointer;
  49.     TxBufPos    : Word;
  50.     RxBuf       : Pointer;
  51.     RxBufPos    : Word;
  52.     RxBufMax    : Word;
  53.     CurrentBaud : Word;
  54.     ParityBits  : Byte;
  55.     StopBits    : Byte;
  56.     DataBits    : Byte;
  57.  
  58.     CONSTRUCTOR Init(APort: Byte);
  59.     DESTRUCTOR Done; VIRTUAL;
  60.  
  61.     FUNCTION  SetBaudRate(ABaudRate: Word): Boolean; VIRTUAL;
  62.     PROCEDURE SetCurrentBaud(ABaudRate: Word); VIRTUAL;
  63.     FUNCTION  GetBaudRate: Word; VIRTUAL;
  64.  
  65.     PROCEDURE WriteByte(AByte: Byte; Flush: Boolean); VIRTUAL;
  66.     PROCEDURE WriteStr(AStr: String); VIRTUAL;
  67.  
  68.     FUNCTION  ReadByte: Byte; VIRTUAL;
  69.     FUNCTION  Peek(VAR AByte: Byte) : Boolean; VIRTUAL;
  70.     FUNCTION  KeyPressed: Boolean; VIRTUAL;
  71.     FUNCTION  OutEmpty: Boolean; VIRTUAL;
  72.     FUNCTION  Carrier: Boolean; VIRTUAL;
  73.  
  74.     PROCEDURE FlushTx; VIRTUAL;
  75.     PROCEDURE FlushOut; VIRTUAL;
  76.     PROCEDURE PurgeOut; VIRTUAL;
  77.     PROCEDURE PurgeIn; VIRTUAL;
  78.  
  79.     PROCEDURE SetDtr(High: Boolean); VIRTUAL;
  80.     PROCEDURE SendBreak; VIRTUAL;
  81.     PROCEDURE SetXOn(AMode: Boolean); VIRTUAL;
  82.     PROCEDURE SetFlowControl(AMask: Word); VIRTUAL; { 9=Xon/Xoff 2=CTS/RTS }
  83.     PROCEDURE SetBreak(AMode: Boolean); VIRTUAL;
  84.     PROCEDURE SetLinkData(DB,SB,PB: BYTE); VIRTUAL;
  85.     FUNCTION  GetLinkData: S5; VIRTUAL;
  86.   PRIVATE
  87.  
  88.     PROCEDURE WriteBlock(VAR ABuffer; ABufSize: Word); VIRTUAL;
  89.     PROCEDURE ReadBlock(VAR ABuffer; ABufSize: Word; VAR ABufUsed: Word); VIRTUAL;
  90.     FUNCTION  GetStatus: AStatus; VIRTUAL;
  91.   END;
  92.  
  93.   PFossilCom = ^TFossilCom;
  94.   TFossilCom = OBJECT(TAbsCom)
  95.     CurrentPort  : Byte;
  96.  
  97.     CONSTRUCTOR Init(APort: Byte);
  98.     DESTRUCTOR Done; VIRTUAL;
  99.  
  100.     FUNCTION  SetBaudRate(ABaudRate: Word): Boolean; VIRTUAL;
  101.  
  102.     FUNCTION  ReadByte: Byte; VIRTUAL;
  103.     FUNCTION  KeyPressed: Boolean; VIRTUAL;
  104.     FUNCTION  OutEmpty: Boolean; VIRTUAL;
  105.     FUNCTION  Carrier: Boolean; VIRTUAL;
  106.  
  107.     PROCEDURE FlushOut; VIRTUAL;
  108.     PROCEDURE PurgeOut; VIRTUAL;
  109.     PROCEDURE PurgeIn; VIRTUAL;
  110.  
  111.     PROCEDURE SetDtr(High: Boolean); VIRTUAL;
  112.     PROCEDURE SendBreak; VIRTUAL;
  113.     PROCEDURE SetXOn(AMode: Boolean); VIRTUAL;
  114.     PROCEDURE SetFlowControl(AMask: Word); VIRTUAL; { 9=Xon/Xoff 2=CTS/RTS }
  115.     PROCEDURE SetBreak(AMode: Boolean); VIRTUAL;
  116.   PRIVATE
  117. {$IFDEF PMode}
  118.     Regs : TRealModeRegs;
  119. {$ELSE}
  120.     Regs : Registers;
  121. {$ENDIF}
  122.  
  123.     PROCEDURE WriteBlock(VAR ABuffer; ABufSize: Word); VIRTUAL;
  124.     PROCEDURE ReadBlock(VAR ABuffer; ABufSize: Word; VAR ABufUsed: Word); VIRTUAL;
  125.     FUNCTION  GetStatus: AStatus; VIRTUAL;
  126.     PROCEDURE FossilInt(AService: Byte); VIRTUAL;
  127.   END;
  128.  
  129. {$IFDEF OS2}
  130.   POS2Com = ^TOS2Com;
  131.   TOS2Com = OBJECT(TAbsCom)
  132.     CurrentPort  : Byte;
  133.     ComHandle    : HFile;
  134.  
  135.     CONSTRUCTOR Init(APort: Byte);
  136.     DESTRUCTOR Done; VIRTUAL;
  137.  
  138.     FUNCTION  SetBaudRate(ABaudRate: Word): Boolean; VIRTUAL;
  139.  
  140.     FUNCTION  ReadByte: Byte; VIRTUAL;
  141.     FUNCTION  KeyPressed: Boolean; VIRTUAL;
  142.     FUNCTION  OutEmpty: Boolean; VIRTUAL;
  143.     FUNCTION  Carrier: Boolean; VIRTUAL;
  144.  
  145.     PROCEDURE FlushOut; VIRTUAL;
  146.     PROCEDURE PurgeOut; VIRTUAL;
  147.     PROCEDURE PurgeIn; VIRTUAL;
  148.  
  149.     PROCEDURE SetDtr(High: Boolean); VIRTUAL;
  150.     PROCEDURE SendBreak; VIRTUAL;
  151.     PROCEDURE SetXOn(AMode: Boolean); VIRTUAL;
  152.     PROCEDURE SetFlowControl(AMask: Word); VIRTUAL; { 9=Xon/Xoff 2=CTS/RTS }
  153.     PROCEDURE SetBreak(AMode: Boolean); VIRTUAL;
  154.   PRIVATE
  155.  
  156.     PROCEDURE WriteBlock(VAR ABuffer; ABufSize: Word); VIRTUAL;
  157.     PROCEDURE ReadBlock(VAR ABuffer; ABufSize: Word; VAR ABufUsed: Word); VIRTUAL;
  158.     FUNCTION  GetStatus: AStatus; VIRTUAL;
  159.     PROCEDURE ChkErr(ErrCode: ApiRet; DosCall, FctName: S40);
  160.   END;
  161.  
  162. {$IFDEF MaxComm}
  163.   PMaxCom = ^TMaxCom;
  164.   TMaxCom = OBJECT(TAbsCom)
  165.     CurrentPort  : Byte;
  166.     ComHandle    : HComm;
  167.  
  168.     CONSTRUCTOR Init(APort: Byte);
  169.     DESTRUCTOR Done; VIRTUAL;
  170.  
  171.     FUNCTION  SetBaudRate(ABaudRate: Word): Boolean; VIRTUAL;
  172.  
  173.     FUNCTION  ReadByte: Byte; VIRTUAL;
  174.     FUNCTION  KeyPressed: Boolean; VIRTUAL;
  175.     FUNCTION  OutEmpty: Boolean; VIRTUAL;
  176.     FUNCTION  Carrier: Boolean; VIRTUAL;
  177.  
  178.     PROCEDURE FlushOut; VIRTUAL;
  179.     PROCEDURE PurgeOut; VIRTUAL;
  180.     PROCEDURE PurgeIn; VIRTUAL;
  181.  
  182.     PROCEDURE SetDtr(High: Boolean); VIRTUAL;
  183.     PROCEDURE SendBreak; VIRTUAL;
  184.     PROCEDURE SetXOn(AMode: Boolean); VIRTUAL;
  185.     PROCEDURE SetFlowControl(AMask: Word); VIRTUAL; { 9=Xon/Xoff 2=CTS/RTS }
  186.     PROCEDURE SetBreak(AMode: Boolean); VIRTUAL;
  187.   PRIVATE
  188.  
  189.     PROCEDURE WriteBlock(VAR ABuffer; ABufSize: Word); VIRTUAL;
  190.     PROCEDURE ReadBlock(VAR ABuffer; ABufSize: Word; VAR ABufUsed: Word); VIRTUAL;
  191.     FUNCTION  GetStatus: AStatus; VIRTUAL;
  192.     PROCEDURE ChkErr(ErrCode: ApiRet; DosCall, FctName: S40);
  193.   END;
  194. {$ENDIF}
  195. {$ENDIF}
  196.  
  197.  
  198. IMPLEMENTATION
  199.  
  200. USES {$IFDEF OS2}OS2Base, OpString, Strings, LogFile, {$ENDIF}
  201.      Util, MTask;
  202.  
  203. CONST
  204.   RDA            = 1;
  205.   OVRN           = 2;
  206.  
  207.   THRE           = 32;
  208.   TSRE           = 64;
  209.  
  210.   CarrierMask    = $80;
  211.  
  212. {$IFDEF PMode}
  213.   PROCEDURE RealModeInt(Int: Byte; VAR Regs: TRealModeRegs); ASSEMBLER;
  214.   ASM
  215.     MOV BL,Int
  216.     XOR BH,BH
  217.     XOR CX,CX
  218.     LES DI,Regs
  219.     MOV AX,0300H
  220.     INT 31H
  221.   END;
  222. {$ENDIF}
  223.  
  224.  
  225. {=== TAbsCom ===}
  226.  
  227.   CONSTRUCTOR TAbsCom.Init(APort: Byte);
  228.   BEGIN
  229.     IF NOT INHERITED Init THEN Fail;
  230.     LastStatus:=0;
  231.     RxBufPos:=0; RxBufMax:=0;
  232.     GetMem(RxBuf, RxBufSize);
  233.     TxBufPos:=0;
  234.     GetMem(TxBuf, TxBufSize);
  235.     ParityBits:=0;
  236.     StopBits:=0;
  237.     DataBits:=3;
  238.   END;
  239.  
  240.   DESTRUCTOR TAbsCom.Done;
  241.   BEGIN
  242.     Dispose(TxBuf);
  243.     Dispose(RxBuf);
  244.     INHERITED Done;
  245.   END;
  246.  
  247.   FUNCTION TAbsCom.SetBaudRate(ABaudRate: Word): Boolean;
  248.   BEGIN
  249.     CurrentBaud:=ABaudRate;
  250.     SetBaudRate:=True;
  251.   END;
  252.  
  253.   PROCEDURE TAbsCom.SetCurrentBaud(ABaudRate: Word);
  254.   BEGIN
  255.     CurrentBaud:=ABaudRate;
  256.   END;
  257.  
  258.   FUNCTION TAbsCom.GetBaudRate: Word;
  259.   BEGIN
  260.     GetBaudRate:=CurrentBaud;
  261.   END;
  262.  
  263.   PROCEDURE TAbsCom.WriteByte(AByte: Byte; Flush: Boolean);
  264.   BEGIN
  265.     BT0(TxBuf^)[TxBufPos]:=AByte;
  266.     Inc(TxBufPos);
  267.     IF (TxBufPos=TxBufSize) OR Flush THEN
  268.     BEGIN
  269.       WriteBlock(TxBuf^, TxBufPos);
  270.       TxBufPos:=0;
  271.     END;
  272.   END;
  273.  
  274.   PROCEDURE TAbsCom.WriteStr(AStr : String);
  275.   VAR
  276.     a : Byte;
  277.   BEGIN
  278.     FOR a:=1 TO Length(AStr) DO
  279.       WriteByte(Byte(AStr[a]), a=Length(AStr));
  280.   END;
  281.  
  282.   FUNCTION TAbsCom.ReadByte: Byte;
  283.   BEGIN
  284.     ReadByte:=0;
  285.   END;
  286.  
  287.   FUNCTION TAbsCom.Peek(VAR AByte: Byte): Boolean;
  288.   BEGIN
  289.     IF RxBufPos=RxBufMax THEN ReadBlock(RxBuf^, RxBufSize, RxBufMax);
  290.     IF RxBufPos=RxBufMax THEN
  291.         Peek:=False
  292.     ELSE
  293.     BEGIN
  294.       AByte:=BT0(RxBuf^)[RxBufPos];
  295.       Peek:=True;
  296.     END;
  297.   END;
  298.  
  299.   FUNCTION TAbsCom.KeyPressed : Boolean;
  300.   BEGIN
  301.     KeyPressed:=False;
  302.   END;
  303.  
  304.   FUNCTION TAbsCom.OutEmpty : Boolean;
  305.   BEGIN
  306.     OutEmpty:=True;
  307.   END;
  308.  
  309.   FUNCTION TAbsCom.Carrier : Boolean;
  310.   BEGIN
  311.     Carrier:=False;
  312.   END;
  313.  
  314.   PROCEDURE TAbsCom.FlushTx;
  315.   BEGIN
  316.     WriteBlock(TxBuf^, TXBufPos);
  317.     TxBufPos:=0;
  318.   END;
  319.  
  320.   PROCEDURE TAbsCom.FlushOut;
  321.   BEGIN
  322.   END;
  323.  
  324.   PROCEDURE TAbsCom.PurgeOut;
  325.   BEGIN
  326.   END;
  327.  
  328.   PROCEDURE TAbsCom.PurgeIn;
  329.   BEGIN
  330.   END;
  331.  
  332.   PROCEDURE TAbsCom.SetDtr(High: Boolean);
  333.   BEGIN
  334.   END;
  335.  
  336.   PROCEDURE TAbsCom.SendBreak;
  337.   BEGIN
  338.   END;
  339.  
  340.   PROCEDURE TAbsCom.SetXOn(AMode: Boolean);
  341.   BEGIN
  342.   END;
  343.  
  344.   PROCEDURE TAbsCom.SetFlowControl(AMask: Word);
  345.   BEGIN
  346.   END;
  347.  
  348.   PROCEDURE TAbsCom.SetBreak(AMode: Boolean);
  349.   BEGIN
  350.   END;
  351.  
  352.   PROCEDURE TAbsCom.SetLinkData(DB,SB,PB: BYTE);
  353.   BEGIN
  354.     IF DB=7 THEN DataBits:=2 ELSE DataBits:=3;
  355.     StopBits:=SB SHL 2;
  356.     ParityBits:=PB SHL 3;
  357.     SetBaudRate(CurrentBaud);
  358.   END;
  359.  
  360.   FUNCTION  TAbsCom.GetLinkData: S5;
  361.   VAR
  362.     s:S5;
  363.   BEGIN
  364.     CASE ParityBits OF
  365.       0,16 : s:='N-';
  366.       8    : s:='O-';
  367.       24   : s:='E-';
  368.     END;
  369.     s:=s+CHR(53+DataBits)+'-'+CHR(49+BYTE(StopBits=4));
  370.     GetLinkData:=s;
  371.   END;
  372.  
  373.   PROCEDURE TAbsCom.WriteBlock(VAR ABuffer; ABufSize: Word);
  374.   BEGIN
  375.   END;
  376.  
  377.   PROCEDURE TAbsCom.ReadBlock(VAR ABuffer; ABufSize: Word; VAR ABufUsed: Word);
  378.   BEGIN
  379.     RxBufPos:=0;
  380.   END;
  381.  
  382.   FUNCTION  TAbsCom.GetStatus: AStatus;
  383.   BEGIN
  384.   END;
  385.  
  386.  
  387. {=== TFossilCom ===}
  388.  
  389.   CONSTRUCTOR TFossilCom.Init(APort: Byte);
  390.   BEGIN
  391.     IF NOT INHERITED Init(APort) THEN Fail;
  392.     Regs.BX:=0;
  393.     CurrentPort:=APort-1;
  394.     FossilInt($04);
  395.     IF Regs.AX<>$1954 THEN
  396.     BEGIN
  397.       INHERITED Done;
  398.       Fail;
  399.     END;
  400.   END;
  401.  
  402.   DESTRUCTOR TFossilCom.Done;
  403.   BEGIN
  404.     FossilInt($05);
  405.     INHERITED Done;
  406.   END;
  407.  
  408.   FUNCTION TFossilCom.SetBaudRate(ABaudRate: Word): Boolean;
  409.   CONST
  410.     BaudRates      : ARRAY[0..7] OF Word = (19200, 38400, 300, 600, 1200, 2400, 4800, 9600);
  411.     Order : ARRAY[0..7] OF Byte = (2,3,4,5,6,7,0,1);
  412.   VAR
  413.     a              : Byte;
  414.   BEGIN
  415.     a:=0;
  416.     WHILE (a<8) AND (BaudRates[Order[a]]<ABaudRate) DO
  417.       Inc(a);
  418.     IF a=8 THEN
  419.     BEGIN
  420.       SetBaudRate:=False;
  421.       IF ABaudRate>2400 THEN CurrentBaud:=ABaudRate;
  422.     END ELSE
  423.     BEGIN
  424.       Regs.AL:=(Order[a] SHL 5)+ParityBits+StopBits+DataBits;
  425.       FossilInt($00);
  426.       SetBaudRate:=True;
  427.       LastStatus:=Regs.AX;
  428.       CurrentBaud:=ABaudRate;
  429.     END;
  430.   END;
  431.  
  432.   FUNCTION TFossilCom.ReadByte: Byte;
  433.   BEGIN
  434.     IF RxBufPos=RxBufMax THEN ReadBlock(RxBuf^, RxBufSize, RxBufMax);
  435.     IF RxBufPos=RXBufMax THEN
  436.     BEGIN
  437.       FossilInt($02);
  438.       ReadByte:=Regs.AL;
  439.     END ELSE
  440.     BEGIN
  441.       ReadByte:=BT0(RxBuf^)[RxBufPos];
  442.       Inc(RxBufPos);
  443.     END;
  444.   END;
  445.  
  446.   FUNCTION TFossilCom.KeyPressed : Boolean;
  447.   BEGIN
  448.     KeyPressed:=(RxBufPos<RxBufMax) OR ((Hi(GetStatus) AND RDA)=RDA);
  449.   END;
  450.  
  451.   FUNCTION TFossilCom.OutEmpty : Boolean;
  452.   BEGIN
  453.     OutEmpty :=(TxBufPos=0) AND ((Hi(GetStatus) AND TSRE) = TSRE);
  454.   END;
  455.  
  456.   FUNCTION TFossilCom.Carrier : Boolean;
  457.   BEGIN
  458.     Carrier := ((Lo(GetStatus) AND CarrierMask) = CarrierMask);
  459.   END;
  460.  
  461.   PROCEDURE TFossilCom.FlushOut;
  462.   BEGIN
  463.     FlushTx;
  464.     FossilInt($08);
  465.   END;
  466.  
  467.   PROCEDURE TFossilCom.PurgeOut;
  468.   BEGIN
  469.     TxBufPos:=0;
  470.     FossilInt($09);
  471.   END;
  472.  
  473.   PROCEDURE TFossilCom.PurgeIn;
  474.   BEGIN
  475.     RxBufPos:=0; RxBufMax:=0;
  476.     FossilInt($0a);
  477.   END;
  478.  
  479.   PROCEDURE TFossilCom.SetDtr(High: Boolean);
  480.   BEGIN
  481.     Regs.AL:=Byte(High);
  482.     FossilInt($06);
  483.   END;
  484.  
  485.   PROCEDURE TFossilCom.SendBreak;
  486.   BEGIN
  487.     Regs.AL:=$01;
  488.     FossilInt($1a);
  489.     Pause(500);
  490.     Regs.AL:=$00;
  491.     FossilInt($1a);
  492.   END;
  493.  
  494.   PROCEDURE TFossilCom.SetXOn(AMode: Boolean);
  495.   BEGIN
  496.     IF AMode = On THEN
  497.       Regs.AL:=11 {HandshakeMask}
  498.     ELSE
  499.       Regs.AL:=2; {HandshakeMask AND (NOT $01);}
  500.     FossilInt($0f);
  501.   END;
  502.  
  503.   PROCEDURE TFossilCom.SetFlowControl(AMask: Word);
  504.   BEGIN
  505.     Regs.AX:=AMask OR $0F00;
  506.     FossilInt($0f);
  507.   END;
  508.  
  509.   PROCEDURE TFossilCom.SetBreak(AMode: Boolean);
  510.   BEGIN
  511.     Regs.Al:=Byte(AMode);
  512.     FossilInt($10);
  513.   END;
  514.  
  515.   FUNCTION TFossilCom.GetStatus: Word;
  516.   BEGIN
  517.     FossilInt($03);
  518.     GetStatus:=Regs.AX;
  519.   END;
  520.  
  521.   PROCEDURE TFossilCom.WriteBlock(VAR ABuffer; ABufSize: Word);
  522.   BEGIN
  523.     Regs.CX:=ABufSize;
  524.     Regs.ES:=Seg(ABuffer);
  525.     Regs.DI:=Ofs(ABuffer);
  526.     REPEAT
  527.       FossilInt($19);
  528.       Regs.CX:=Regs.CX-Regs.AX;
  529.       Inc(Regs.DI, Regs.AX);
  530.       IF (Regs.CX>128) AND (MultiTasker=1) THEN GiveUpTime;
  531.     UNTIL (Regs.CX=0) OR NOT Carrier;
  532.   END;
  533.  
  534.   PROCEDURE TFossilCom.ReadBlock(VAR ABuffer; ABufSize: Word; VAR ABufUsed: Word);
  535.   BEGIN
  536.     Regs.CX:=ABufSize;
  537.     Regs.ES:=Seg(ABuffer);
  538.     Regs.DI:=Ofs(ABuffer);
  539.     FossilInt($18);
  540.     ABufUsed:=Regs.AX;
  541.     RxBufPos:=0;
  542.   END;
  543.  
  544.   PROCEDURE TFossilCom.FossilInt(AService: Byte);
  545.   BEGIN
  546.     Regs.AH := AService;
  547.     Regs.DX := CurrentPort;
  548. {$IFDEF PMode}
  549.     RealModeInt($14, Regs);
  550. {$ELSE}
  551.     Intr($14, Regs);
  552. {$ENDIF}
  553.   END;
  554.  
  555.  
  556. {$IFDEF OS2}
  557.  
  558. {=== TOS2Com ===}
  559.  
  560.   CONSTRUCTOR TOS2Com.Init(APort: Byte);
  561.   VAR
  562.     Action : ULong;
  563.     Z      : ARRAY[0..10] OF Char;
  564.     CH     : HFile;
  565.   BEGIN
  566.     IF NOT INHERITED Init(APort) THEN Fail;
  567.     StrPCopy(Z, 'COM'+Long2Str(APort));
  568.     ChkErr(DosOpen(Z, CH, Action, 0, $0000,
  569.                    OPEN_ACTION_OPEN_IF_EXISTS,
  570.                    OPEN_ACCESS_READWRITE OR OPEN_SHARE_DENYREADWRITE OR OPEN_FLAGS_FAIL_ON_ERROR,
  571.                    NIL),'DosOpen','OS2Com.Init');
  572.     ComHandle:=CH;
  573.     IF LastStatus<>No_Error THEN
  574.     BEGIN
  575.       WriteLn('ComPort open error: ',LastStatus);
  576.       INHERITED Done;
  577.       Fail;
  578.     END;
  579.   END;
  580.  
  581.   DESTRUCTOR TOS2Com.Done;
  582.   BEGIN
  583.     ChkErr(DosClose(ComHandle),'DosClose','OS2Com.Done');
  584.     INHERITED Done;
  585.   END;
  586.  
  587.   FUNCTION TOS2Com.SetBaudRate(ABaudRate: Word): Boolean;
  588.   VAR
  589.     ParmLen     : ULong;
  590.     BaudRateRec : RECORD
  591.                     BaudRate    : ULONG;
  592.                     Fraction    : BYTE
  593.                   END;
  594.  
  595.   BEGIN
  596.     BaudRateRec.BaudRate:=ABaudRate;
  597.     BaudRateRec.Fraction:=0;
  598.     ParmLen:=SizeOf(BaudRateRec);
  599.     ChkErr(DosDevIoCtl(ComHandle,IOCtl_Async,Async_ExtSetBaudRate,@BaudRateRec,6,@ParmLen,NIL,0,NIL),
  600.                        'DosDevIOCtl','FSetBaudR');
  601.     SetBaudRate:=(LastStatus=No_Error);
  602.     CurrentBaud:=ABaudRate;
  603.   END;
  604.  
  605.   FUNCTION TOS2Com.ReadByte: Byte;
  606.   VAR
  607.     B : Byte;
  608.     BytesRead : Word;
  609.   BEGIN
  610.     IF RxBufPos=RxBufMax THEN ReadBlock(RxBuf^, RxBufSize, RxBufMax);
  611.     IF RxBufPos=RXBufMax THEN
  612.     BEGIN
  613.       ChkErr(DosRead(ComHandle,B,1,BytesRead),'DosRead','FReadByte');
  614.       ReadByte:=B;
  615.     END ELSE
  616.     BEGIN
  617.       ReadByte:=BT0(RxBuf^)[RxBufPos];
  618.       Inc(RxBufPos);
  619.     END;
  620.   END;
  621.  
  622.   FUNCTION TOS2Com.KeyPressed : Boolean;
  623.   TYPE
  624.     BUFFREC = Record      { For storing TX or RX buffer records }
  625.       Bytesin,           { Number of bytes in buffer }
  626.       FullSize : word;   { Size of the buffer }
  627.     end;
  628.   VAR
  629.     BufferRec : BuffRec;
  630.     RetLength : LongInt;
  631.   BEGIN
  632.     IF (RxBufPos<RxBufMax) THEN
  633.       KeyPressed:=True
  634.     ELSE
  635.     BEGIN
  636.       ChkErr(DosDevIOCtl(ComHandle,IOCtl_Async,Async_GetInQueCount,NIL,0,NIL,@BufferRec,SizeOf(BufferRec),@RetLength),
  637.                          'DosDevIOCtl','TOS2Com.Keypressed');
  638.       KeyPressed:=(BufferRec.BytesIn>0);
  639.     END;
  640.   END;
  641.  
  642.   FUNCTION TOS2Com.OutEmpty : Boolean;
  643.   BEGIN
  644. {!!!}
  645.     OutEmpty :=(TxBufPos=0) AND ((Hi(GetStatus) AND TSRE) = TSRE);
  646.   END;
  647.  
  648.   FUNCTION TOS2Com.Carrier : Boolean;
  649.   BEGIN
  650. {!!!}
  651.     Carrier := ((Lo(GetStatus) AND CarrierMask) = CarrierMask);
  652.   END;
  653.  
  654.   PROCEDURE TOS2Com.FlushOut;
  655.   BEGIN
  656.     FlushTx;
  657.     ChkErr(-1,'NOT IMPLEMENTED','TOS2Com.FlushOut');
  658.   END;
  659.  
  660.   PROCEDURE TOS2Com.PurgeOut;
  661.   BEGIN
  662.     TxBufPos:=0;
  663.     ChkErr(-1,'NOT IMPLEMENTED','TOS2Com.PurgeOut');
  664.   END;
  665.  
  666.   PROCEDURE TOS2Com.PurgeIn;
  667.   BEGIN
  668.     ReadBlock(RxBuf^, RxBufSize, RxBufMax);
  669.     RxBufPos:=0; RxBufMax:=0;
  670.   END;
  671.  
  672.   PROCEDURE TOS2Com.SetDtr(High: Boolean);
  673.   VAR
  674.     MS : ModemStatus;
  675.     ComErr : Word;
  676.     ParmLen : ULONG;
  677.   BEGIN
  678.     FillChar(MS, SizeOf(MS), 0);
  679.     IF High THEN MS.fbModemOn:=dtr_On ELSE MS.fbModemOff:=dtr_Off;
  680.     ParmLen:=SizeOf(MS);
  681.     ChkErr(DosDevIoCtl(ComHandle,IOCtl_Async,Async_SetModemCtrl,@MS,SizeOf(MS),@ParmLen,@ComErr,SizeOf(ComErr),@ParmLen),
  682.                        'DosDevIOCtl','FSetDtr');
  683.   END;
  684.  
  685.   PROCEDURE TOS2Com.SendBreak;
  686.   BEGIN
  687.     ChkErr(-1,'NOT IMPLEMENTED','TOS2Com.SendBreak');
  688.   END;
  689.  
  690.   PROCEDURE TOS2Com.SetXOn(AMode: Boolean);
  691.   BEGIN
  692.     ChkErr(-1,'NOT IMPLEMENTED','TOS2Com.SetXOn');
  693.   END;
  694.  
  695.   PROCEDURE TOS2Com.SetFlowControl(AMask: Word);
  696.   BEGIN
  697.     ChkErr(-1,'NOT IMPLEMENTED','TOS2Com.SetFlowControl');
  698.   END;
  699.  
  700.   PROCEDURE TOS2Com.SetBreak(AMode: Boolean);
  701.   BEGIN
  702.     ChkErr(-1,'NOT IMPLEMENTED','TOS2Com.SetBreak');
  703.   END;
  704.  
  705.   PROCEDURE TOS2Com.WriteBlock(VAR ABuffer; ABufSize: Word);
  706.   VAR
  707.     Written     : ULong;
  708.   BEGIN
  709.     ChkErr(DosWrite(ComHandle,ABuffer,ABufSize,Written),'DosWrite','WriteBlock');
  710.   END;
  711.  
  712.   PROCEDURE TOS2Com.ReadBlock(VAR ABuffer; ABufSize: Word; VAR ABufUsed: Word);
  713.   BEGIN
  714.     ChkErr(DosRead(ComHandle,ABuffer,ABufSize,ABufUsed),'DosRead','ReadBlock');
  715.     RxBufPos:=0;
  716.   END;
  717.  
  718.   FUNCTION TOS2Com.GetStatus: Word;
  719.   VAR
  720.     status : byte;
  721.     retlength : longint;
  722.   BEGIN
  723.     ChkErr(DosDevIOCtl(ComHandle,IOCtl_Async,Async_GetModemInput,NIL,0,NIL,@status,1,@retlength),'DosDevIOCtl','FGetStatus');
  724.     GetStatus:=Status;
  725.   END;
  726.  
  727.   PROCEDURE TOS2Com.ChkErr(ErrCode: ApiRet; DosCall, FctName: S40);
  728.   BEGIN
  729.     IF ErrCode<>No_Error THEN
  730.     BEGIN
  731.       AddLog('!', 'FOSSIL: Error '+Long2Str(ErrCode)+' from '+DosCall+' in '+FctName);
  732.     END;
  733.     LastStatus:=ErrCode;
  734.   END;
  735.  
  736.  
  737. {=== TMaxCom ===}
  738. {$IFDEF MaxComm}
  739.   CONSTRUCTOR TMaxCom.Init(APort: Byte);
  740.   VAR
  741.     Action : ULong;
  742.     Z      : ARRAY[0..10] OF Char;
  743. {    CH     : HFile;}
  744.   BEGIN
  745.     IF NOT INHERITED Init(APort) THEN Fail;
  746.     StrPCopy(Z, 'COM'+Long2Str(APort));
  747.     ChkErr(ComOpen(Z, ComHandle, 4096, 4096),'ComOpen','TMaxCom.Init');
  748.     IF LastStatus<>No_Error THEN
  749.     BEGIN
  750.       WriteLn('ComPort open error: ',LastStatus);
  751.       INHERITED Done;
  752.       Fail;
  753.     END;
  754.   END;
  755.  
  756.   DESTRUCTOR TMaxCom.Done;
  757.   BEGIN
  758.     ChkErr(ComClose(ComHandle),'ComClose','TMaxCom.Done');
  759.     INHERITED Done;
  760.   END;
  761.  
  762.   FUNCTION TMaxCom.SetBaudRate(ABaudRate: Word): Boolean;
  763.   BEGIN
  764.     ChkErr(ComSetBaudRate(ComHandle, ABaudRate, 'N', 8, 1), 'ComSetBaudRate', 'SetBaudRate');
  765.     SetBaudRate:=(LastStatus=No_Error);
  766.     CurrentBaud:=ABaudRate;
  767.   END;
  768.  
  769.   FUNCTION TMaxCom.ReadByte: Byte;
  770.   VAR
  771.     B : Byte;
  772.     BytesRead : Word;
  773.     i : SHORT;
  774.   BEGIN
  775.     IF RxBufPos=RxBufMax THEN ReadBlock(RxBuf^, RxBufSize, RxBufMax);
  776.     IF RxBufPos=RXBufMax THEN
  777.     BEGIN
  778.       i:=ComGetc(ComHandle);
  779.       IF i>=0 THEN ReadByte:=Lo(i) ELSE B:=0;
  780.     END ELSE
  781.     BEGIN
  782.       ReadByte:=BT0(RxBuf^)[RxBufPos];
  783.       Inc(RxBufPos);
  784.     END;
  785.   END;
  786.  
  787.   FUNCTION TMaxCom.KeyPressed : Boolean;
  788.   BEGIN
  789.     IF (RxBufPos<RxBufMax) THEN
  790.       KeyPressed:=True
  791.     ELSE
  792.     BEGIN
  793.       KeyPressed:=(ComInCount(ComHandle)>0);
  794.     END;
  795.   END;
  796.  
  797.   FUNCTION TMaxCom.OutEmpty : Boolean;
  798.   BEGIN
  799.     OutEmpty :=(TxBufPos=0) AND (ComOutCount(ComHandle)=0);
  800.   END;
  801.  
  802.   FUNCTION TMaxCom.Carrier : Boolean;
  803.   BEGIN
  804.     Carrier := Bool(ComIsOnline(ComHandle));
  805.   END;
  806.  
  807.   PROCEDURE TMaxCom.FlushOut;
  808.   BEGIN
  809.     FlushTx;
  810.     ChkErr(ComTxWait(ComHandle, -1),'ComTxWait','TMaxCom.FlushOut');
  811.   END;
  812.  
  813.   PROCEDURE TMaxCom.PurgeOut;
  814.   BEGIN
  815.     TxBufPos:=0;
  816.     ChkErr(ComPurge(ComHandle, COMM_PURGE_TX),'ComPurge','TMaxCom.PurgeOut');
  817.   END;
  818.  
  819.   PROCEDURE TMaxCom.PurgeIn;
  820.   BEGIN
  821.     ChkErr(ComPurge(ComHandle, COMM_PURGE_RX),'ComPurge','TMaxCom.PurgeOut');
  822.     RxBufPos:=0; RxBufMax:=0;
  823.   END;
  824.  
  825.   PROCEDURE TMaxCom.SetDtr(High: Boolean);
  826.   VAR
  827.     MS : ModemStatus;
  828.     ComErr : Word;
  829.     ParmLen : ULONG;
  830.   BEGIN
  831. {
  832.     FillChar(MS, SizeOf(MS), 0);
  833.     IF High THEN MS.fbModemOn:=dtr_On ELSE MS.fbModemOff:=dtr_Off;
  834.     ParmLen:=SizeOf(MS);
  835.     ChkErr(DosDevIoCtl(ComHandle,IOCtl_Async,Async_SetModemCtrl,@MS,SizeOf(MS),@ParmLen,@ComErr,SizeOf(ComErr),@ParmLen),
  836.                        'DosDevIOCtl','FSetDtr');}
  837.     ChkErr(-1,'NOT IMPLEMENTED???!!!','SetDtr');
  838.   END;
  839.  
  840.   PROCEDURE TMaxCom.SendBreak;
  841.   BEGIN
  842.     ChkErr(-1,'NOT IMPLEMENTED','TMaxCom.SendBreak');
  843.   END;
  844.  
  845.   PROCEDURE TMaxCom.SetXOn(AMode: Boolean);
  846.   BEGIN
  847.     ChkErr(-1,'NOT IMPLEMENTED','TMaxCom.SetXOn');
  848.   END;
  849.  
  850.   PROCEDURE TMaxCom.SetFlowControl(AMask: Word);
  851.   BEGIN
  852.     ChkErr(-1,'NOT IMPLEMENTED','TMaxCom.SetFlowControl');
  853.   END;
  854.  
  855.   PROCEDURE TMaxCom.SetBreak(AMode: Boolean);
  856.   BEGIN
  857.     ChkErr(-1,'NOT IMPLEMENTED','TMaxCom.SetBreak');
  858.   END;
  859.  
  860.   PROCEDURE TMaxCom.WriteBlock(VAR ABuffer; ABufSize: Word);
  861.   VAR
  862.     Written     : ULong;
  863.   BEGIN
  864.     ChkErr(ComWrite(ComHandle,ABuffer,ABufSize),'ComWrite','TMaxCom.WriteBlock');
  865.   END;
  866.  
  867.   PROCEDURE TMaxCom.ReadBlock(VAR ABuffer; ABufSize: Word; VAR ABufUsed: Word);
  868.   BEGIN
  869.     ChkErr(ComRead(ComHandle,ABuffer,ABufSize,ABufUsed),'ComRead','TMaxCom.ReadBlock');
  870.     RxBufPos:=0;
  871.   END;
  872.  
  873.   FUNCTION TMaxCom.GetStatus: Word;
  874.   VAR
  875.     status : byte;
  876.     retlength : longint;
  877.   BEGIN
  878. {   ChkErr(DosDevIOCtl(ComHandle,IOCtl_Async,Async_GetModemInput,NIL,0,NIL,@status,1,@retlength),
  879.                        'DosDevIOCtl','FGetStatus');}
  880.     ChkErr(-1,'NOT IMPLEMENTED','TMaxCom.GetStatus');
  881.     GetStatus:=0;
  882.   END;
  883.  
  884.   PROCEDURE TMaxCom.ChkErr(ErrCode: ApiRet; DosCall, FctName: S40);
  885.   BEGIN
  886.     IF ErrCode<>No_Error THEN
  887.     BEGIN
  888.       AddLog('!', 'FOSSIL: Error '+Long2Str(ErrCode)+' from '+DosCall+' in '+FctName);
  889.     END;
  890.     LastStatus:=ErrCode;
  891.   END;
  892. {$ENDIF}
  893. {$ENDIF}
  894.  
  895. END.
  896.  
  897.